## Azalpena ---------------------------
##
## Script name: Bourciez MDS maparatua
##
## Purpose of script:
##
## Author: Juan
##
## Date Created: 2019-05-17
##
## Email: juan.abasolo@ehu.eus
##
## Oharrak ---------------------------
##
## Notes:
##
##
## Beharrezko paketeak ---------------------------
require(reshape2)
## Loading required package: reshape2
require(diaMeasures)
## Loading required package: diaMeasures
require(plot3D)
## Loading required package: plot3D
require(scales)
## Loading required package: scales
require(scatterplot3d)
## Loading required package: scatterplot3d
require(rgdal)
## Loading required package: rgdal
## Loading required package: sp
## rgdal: version: 1.4-3, (SVN revision 828)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 2.2.3, released 2017/11/20
## Path to GDAL shared files: /usr/share/gdal/2.2
## GDAL binary built with GEOS: TRUE
## Loaded PROJ.4 runtime: Rel. 4.9.3, 15 August 2016, [PJ_VERSION: 493]
## Path to PROJ.4 shared files: (autodetected)
## Linking to sp version: 1.3-1
require(sp)
library(RColorBrewer)
## Datuak sartu ---------------------------
## Datuak sartu
dtk.brcz <- read.table('data/raw/bourciez-taulazabalduan-b.csv', sep = ',', header = T)
names(dtk.brcz) <- read.table('data/raw/bourciez-taulazabalduan-b.csv', sep = ',', stringsAsFactors = F)[1,]
row.names(dtk.brcz) <- dtk.brcz[,1]
dtk.brcz <- dtk.brcz[,-1]
# NA gehiegi daukaz Hendaiak
dtk.brcz <- dtk.brcz[-which(row.names(dtk.brcz)=="Hendaia"),]
## Mapa Sartu
mapi <- readOGR('data/maps/EH_Udalerriak-Barri/udalerriak_EH_berriaB.shp')
## OGR data source with driver: ESRI Shapefile
## Source: "/home/juan/Insync/Pertsonala/iker-Mahaigaina/baRriro [R]/190430_Baionan aurkezteko/data/maps/EH_Udalerriak-Barri/udalerriak_EH_berriaB.shp", layer: "udalerriak_EH_berriaB"
## with 758 features
## It has 9 fields
## Distantzia matrizea sortu---------------------------
## Datuen prestaketa
dtk.tnp <- cbind(herria = row.names(dtk.brcz), dtk.brcz)
names.bcrz <- names(dtk.tnp)
dtk.bcrz.luze <- melt(dtk.tnp, id.vars = 'herria', variable.name = 'erantzunak')
## Warning: attributes are not identical across measure variables; they will
## be dropped
## Distantzia
d.brcz <- as.dist(diaMeasures::diaMeasure(data = dtk.bcrz.luze,
formula = herria~erantzunak,
value.var = 'value',
measure = 'iri',
binaryIndex = 'dice'))
## Erakutsi
knitr::kable(as.matrix(d.brcz)[1:10,1:10], digits = 2)
| Ahatsa-Altzieta-Bazkazane |
0.00 |
45.97 |
40.73 |
50.40 |
39.52 |
43.55 |
35.89 |
46.77 |
45.56 |
55.65 |
| Ahetze |
45.97 |
0.00 |
33.06 |
51.61 |
33.87 |
25.81 |
36.29 |
45.97 |
30.65 |
56.05 |
| Aiherra |
40.73 |
33.06 |
0.00 |
46.77 |
34.68 |
31.45 |
37.10 |
40.73 |
35.89 |
51.21 |
| Ainharbe |
50.40 |
51.61 |
46.77 |
0.00 |
47.18 |
50.40 |
46.37 |
45.16 |
52.02 |
32.66 |
| Ainhize-Monjolose |
39.52 |
33.87 |
34.68 |
47.18 |
0.00 |
33.87 |
29.44 |
35.89 |
40.73 |
47.98 |
| Ainhoa |
43.55 |
25.81 |
31.45 |
50.40 |
33.87 |
0.00 |
35.48 |
40.32 |
32.66 |
54.03 |
| Aintzila |
35.89 |
36.29 |
37.10 |
46.37 |
29.44 |
35.48 |
0.00 |
37.50 |
35.08 |
51.21 |
| Aiziritze-Gamue-Zohazti |
46.77 |
45.97 |
40.73 |
45.16 |
35.89 |
40.32 |
37.50 |
0.00 |
42.34 |
45.97 |
| Aldude |
45.56 |
30.65 |
35.89 |
52.02 |
40.73 |
32.66 |
35.08 |
42.34 |
0.00 |
58.87 |
| Aloze-Ziboze-Onizegaine |
55.65 |
56.05 |
51.21 |
32.66 |
47.98 |
54.03 |
51.21 |
45.97 |
58.87 |
0.00 |
## MDS
mds.bcrz <- cmdscale(d.brcz, k = 3)
## Koloreak
col.mds <- rgb(rescale(1-mds.bcrz[,], to = c(0, 1)))
## Irudiak ---------------------------
## 2D
plot(mds.bcrz[,1:2], col = col.mds, pch = 20, cex = 2.5)
text(mds.bcrz[,1:2], labels = row.names(mds.bcrz), col = 'gray40', cex = 0.7)
## 3D
scatter3D(mds.bcrz[,1], mds.bcrz[,2], mds.bcrz[,3],
type = 'h',
pch = 20,
cex = 1.5,
bty = "f",
col = 1,
theta = 35,
phi = 20
)
text3D(mds.bcrz[,1], mds.bcrz[,2], mds.bcrz[,3],
labels = row.names(mds.bcrz),
col = col.mds,
cex = 0.7,
add = T)
title(main = 'Bourciezen datuen esklatze multidimentsionala (MDS)')
## Mapak ---------------------------
##
## Maparatuta:
df <- data.frame(mds.bcrz)
df$col <- col.mds
mapi@data$col.mds <- 0
for(i in row.names(df)){
# print(i)
mapi@data[mapi@data$IZ_EUSKAL==i, "col.mds"] <- df[i, 'col']
}
plot(mapi, col = mapi@data$col.mds,
main = 'Bourciezen datuen esklatze multidimentsionala (MDS) maparatuta')
legend("bottomleft",
legend = c('1. dim', '2. dim', '3. dim'),
title = 'MDS dimentsioak',
col = c(2:4),
pch = 20)
## Paleta ---------------------------
## Paletik 17 maila bihar leukez gitxienez, hamen gitxio erabilikotez.
display.brewer.all()
cols <- brewer.pal(12, 'Paired')
## Aldagai bat maparatu ---------------------------
# ## aimar
# mapi@data$aimer <- NA
#
# for(i in row.names(dtk.brcz)){
# # print(i)
# mapi@data[mapi@data$IZ_EUSKAL==i, 'aimer'] <- dtk.brcz[i, "aimer"]
# }
#
#
# plot(mapi, col=cols[as.numeric(mapi@data$aimer)],
# main = 'Frantsesezko aimer emateko moduak Bourciezen datuetan')
# legend("bottomleft",
# legend = levels(mapi@data$aimer),
# title = 'Euskarazko formak',
# col = cols[1:length(levels(mapi@data$aimer))],
# pch = 20)
#
# ## Vin
#
# mapi@data$vin <- NA
#
# for(i in row.names(dtk.brcz)){
# # print(i)
# mapi@data[mapi@data$IZ_EUSKAL==i, 'vin'] <- dtk.brcz[i, "vin"]
# }
#
#
#
# plot(mapi, col=cols[as.numeric(mapi@data$vin)],
# main = 'Frantsesezko vin emateko moduak Bourciezen datuetan')
# mapi@data$vin <- factor(mapi@data$vin, levels = levels(dtk.brcz$vin))
# legend("bottomleft",
# legend = levels(mapi@data$vin),
# title = 'Euskarazko formak',
# col = cols[1:length(levels(mapi@data$vin))],
# pch = 20)
#
# ## baiser
#
# mapi@data$baiser <- NA
#
# for(i in row.names(dtk.brcz)){
# # print(i)
# mapi@data[mapi@data$IZ_EUSKAL==i, 'baiser'] <- dtk.brcz[i, "baiser"]
# }
#
# #
#
# plot(mapi, col=cols[as.numeric(mapi@data$baiser)],
# main = 'Frantsesezko baiser emateko moduak Bourciezen datuetan')
# mapi@data$baiser <- factor(mapi@data$baiser, levels = levels(dtk.brcz$baiser))
# legend("bottomleft",
# legend = levels(mapi@data$baiser),
# title = 'Euskarazko formak',
# col = cols[1:length(levels(mapi@data$baiser))],
# pch = 20)
#
# ## buit
# mapi@data$bruit <- NA
#
# for(i in row.names(dtk.brcz)){
# # print(i)
# mapi@data[mapi@data$IZ_EUSKAL==i, 'bruit'] <- dtk.brcz[i, "bruit"]
# }
#
# #
#
# plot(mapi, col=cols[as.numeric(mapi@data$bruit)],
# main = 'Frantsesezko bruit emateko moduak Bourciezen datuetan')
# mapi@data$bruit <- factor(mapi@data$bruit, levels = levels(dtk.brcz$bruit))
# legend("bottomleft",
# legend = levels(mapi@data$bruit),
# title = 'Euskarazko formak',
# col = cols[1:length(levels(mapi@data$bruit))],
# pch = 20)
#
# ## Voler
#
# mapi@data$voler <- NA
#
# for(i in row.names(dtk.brcz)){
# # print(i)
# mapi@data[mapi@data$IZ_EUSKAL==i, 'voler'] <- dtk.brcz[i, "voler"]
# }
#
# #
#
# plot(mapi, col=cols[as.numeric(mapi@data$voler)],
# main = 'Frantsesezko voler emateko moduak Bourciezen datuetan')
# mapi@data$voler <- factor(mapi@data$voler, levels = levels(dtk.brcz$voler))
# legend("bottomleft",
# legend = levels(mapi@data$voler),
# title = 'Euskarazko formak',
# col = cols[1:length(levels(mapi@data$voler))],
# pch = 20)
#
## Voler
mapi@data$voler <- NA
for(i in row.names(dtk.brcz)){
# print(i)
mapi@data[mapi@data$IZ_EUSKAL==i, 'voler'] <- dtk.brcz[i, "voler"]
}
#
plot(mapi, col=cols[as.numeric(mapi@data$voler)],
main = 'Frantsesezko voler emateko moduak Bourciezen datuetan')
mapi@data$voler <- factor(mapi@data$voler, levels = levels(dtk.brcz$voler))
legend("bottomleft",
legend = levels(mapi@data$voler),
title = 'Euskarazko formak',
col = cols[1:length(levels(mapi@data$voler))],
pch = 20)
## AURREKOA FUNTZINORA PASAU ---------------------------
##
## Mailak kontau, 12 baino gehixago ala gitxiago
itema <- '\"Inor\" izenordain zehaztugabea'
mailak <- levels(dtk.brcz[, itema])
laburtu <- function(mailak){
mailak <- c(mailak[1:11], 'beste batzuk')
print(mailak)
}
mapatxu <- function(itema){
mailak <- levels(dtk.brcz[, itema])
mailak <- if(length(mailak)>12) laburtu(mailak) else mailak
mailak <- if(length(mailak)<3)c(mailak, 1, 2) else mailak
cols <- brewer.pal(length(mailak), 'Paired')
mapi@data[, itema] <- NA
for(i in row.names(dtk.brcz)){
# print(i)
mapi@data[mapi@data$IZ_EUSKAL==i, itema] <- dtk.brcz[i, itema]
}
plot(mapi, col=ifelse(is.na(as.numeric(mapi@data[, itema])), 1, cols[as.numeric(mapi@data[, itema])]),
main = paste(itema, 'emateko moduak Bourciezen datuetan'))
mapi@data[, itema] <- factor(mapi@data[, itema], levels = levels(dtk.brcz[, itema]))
legend("bottomleft",
legend = levels(mapi@data[, itema][1:length(mailak)]),
title = 'Euskarazko formak',
col = cols[1:length(levels(mapi@data[, itema]))],
pch = 20)
}
## Maparatu
mapatxu(names(dtk.brcz)[9])
## [1] "-lakotz" "ba-" "bait-" "eta ba-"
## [5] "ezen" "ezen ba-" "ezen bait-" "ezi"
## [9] "ezi(k) ba-" "ezik bait-" "ezin ba-" "beste batzuk"
for(i in names(dtk.brcz[,1:50]))mapatxu(i)
## [1] "-lakotz" "ba-" "bait-" "eta ba-"
## [5] "ezen" "ezen ba-" "ezen bait-" "ezi"
## [9] "ezi(k) ba-" "ezik bait-" "ezin ba-" "beste batzuk"
## [1] "ekarzu" "emaazu" "emaazut"
## [4] "emadazu" "emadazut" "eman"
## [7] "eman (d)ezadazu" "eman dautazu" "eman dezadazut"
## [10] "eman ezazu" "eman izadazu" "beste batzuk"
## [1] "(t)zaizte" "(t)ziauzte" "(t)ziauztere" "jin zaitezte"
## [5] "jin zakitzoe" "jin zataie" "jin ziezte" "jin zite"
## [9] "jin zitie" "jin zizte" "zaite" "beste batzuk"
